home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol117 / menu.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-15  |  7.5 KB  |  241 lines
  1. 90  WIDTH "scrn:",80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "MENU of Programs in Genealogy"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.0"
  6. 115  COPY1$ = "Copyright (c) 1983, 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Make sure that BASIC was invoked with /s:256
  13. 146  ON ERROR GOTO 161
  14. 150  OPEN "a:testfile" AS #1 LEN = 256
  15. 151  ON ERROR GOTO 0
  16. 155  FIELD 1, 128 AS DUMY1$, 128 AS DUMY2$
  17. 156  CLOSE #1
  18. 158  GOTO 170
  19. 161  IF ERR = 5 THEN 162 ELSE ON ERROR GOTO 0 : GOTO 150
  20. 162  REM File Buffer less than 256 bytes
  21. 163  CLS : LOCATE 10,1 : COLOR 4,0
  22. 164  PRINT "BASIC must be brought up with /s:256, for Genealogy Records."
  23. 165  PRINT "Program has been Terminated."
  24. 166  PRINT "Type CONT (and press RETURN) to return to DOS"
  25. 167  COLOR 7,0 : STOP
  26. 168  SYSTEM
  27. 170  REM Produce the first screen
  28. 175  KEY OFF : CLS
  29. 180  REM Draw the outer double box
  30. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  31. 190  REM Find the title location
  32. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  33. 200  REM Draw the title box
  34. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  35. 210  REM Print the title
  36. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  37. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  38. 225  REM Draw the Contribution box
  39. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  40. 235  REM Request the Contribution
  41. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  42. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  43. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  44. 255  REM Draw the Mailing Label
  45. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  46. 265  REM Print the Name and Address
  47. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  48. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  49. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  50. 285  REM Draw the Copyright box
  51. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  52. 295  REM Print the Copyright
  53. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  54. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  55. 310  GOTO 740
  56. 400  REM subroutine to print a double box
  57. 405  COLOR 5
  58. 410  FOR I = R1 + 1 TO R2 - 1
  59. 420   LOCATE I, C1 : PRINT CHR$(186);
  60. 430   LOCATE I, C2 : PRINT CHR$(186);
  61. 440  NEXT I
  62. 450  FOR J = C1 + 1 TO C2 - 1
  63. 460   LOCATE R1, J : PRINT CHR$(205);
  64. 470   LOCATE R2, J : PRINT CHR$(205);
  65. 480  NEXT J
  66. 490   LOCATE R1, C1 : PRINT CHR$(201);
  67. 500   LOCATE R1, C2 : PRINT CHR$(187);
  68. 510   LOCATE R2, C1 : PRINT CHR$(200);
  69. 520   LOCATE R2, C2 : PRINT CHR$(188);
  70. 525  COLOR 7
  71. 530  RETURN
  72. 600  REM subroutine to print a single box
  73. 605  COLOR 3
  74. 610  FOR I = R1 + 1 TO R2 - 1
  75. 620   LOCATE I, C1 : PRINT CHR$(179);
  76. 630   LOCATE I, C2 : PRINT CHR$(179);
  77. 640  NEXT I
  78. 650  FOR J = C1 + 1 TO C2 - 1
  79. 660   LOCATE R1, J : PRINT CHR$(196);
  80. 670   LOCATE R2, J : PRINT CHR$(196);
  81. 680  NEXT J
  82. 690   LOCATE R1, C1 : PRINT CHR$(218);
  83. 700   LOCATE R1, C2 : PRINT CHR$(191);
  84. 710   LOCATE R2, C1 : PRINT CHR$(192);
  85. 720   LOCATE R2, C2 : PRINT CHR$(217);
  86. 725  COLOR 7
  87. 730  RETURN
  88. 740  REM ask user to press a key to continue
  89. 750  LOCATE 25,1
  90. 760  PRINT "Have Program Diskette in place, then press any key to continue.";
  91. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  92. 780  CLS
  93. 1000  REM Menu of the available Genealogy Programs.
  94. 1010  REM By:  Melvin O. Duke.  Last Updated:  24 December 1984.
  95. 1020  REM Draw the Menu itself.
  96. 1030  REM Draw the Outer Double Box.
  97. 1040  R1 = 1 : C1 = 1 : R2 = 23 : C2 = 79 : GOSUB 400
  98. 1050  REM Draw the Heading Separator.
  99. 1060  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2690
  100. 1070  REM Draw the Vertical Separators.
  101. 1080  R1 = 1 : C1 = 6 : R2 = 23 : C2 = 6 : GOSUB 2830
  102. 1090  R1 = 1 : C1 =17 : R2 = 23 : C2 =17 : GOSUB 2830
  103. 1100  REM Attach the intersections
  104. 1105  COLOR 5
  105. 1110  LOCATE 3, 6 : PRINT CHR$(197);
  106. 1120  LOCATE 3,17 : PRINT CHR$(197);
  107. 1125  COLOR 7,0
  108. 1130  REM Print the content of the menu.
  109. 1140  COLOR 0,7
  110. 1150  LOCATE 2,3 : PRINT "No";
  111. 1160  LOCATE 2,8 : PRINT "Name"
  112. 1170  LOCATE 2,19 : PRINT "Function of the Program"
  113. 1180  COLOR 7,0
  114. 1190  COLOR 0,7 : LOCATE  4,3 : PRINT " 1"; : COLOR 4,0
  115. 1200  LOCATE  4,  8 : PRINT "CREATPER";
  116. 1210  LOCATE  4, 19 : PRINT "Creates a Persons File.  (Re-running destroys old file.)";
  117. 1220  COLOR 0,7 : LOCATE  5,3 : PRINT " 2"; : COLOR 4,0
  118. 1230  LOCATE  5,  8 : PRINT "CREATMAR";
  119. 1240  LOCATE  5, 19 : PRINT "Creates a Marriages File.  (Re-running destroys old file.)";
  120. 1250  COLOR 0,7 : LOCATE  6,3 : PRINT " 3"; : COLOR 4,0
  121. 1260  LOCATE  6,  8 : PRINT "CREATORD";
  122. 1270  LOCATE  6, 19 : PRINT "Creates an Ordinances File.  (Re-running destroys old file.)";
  123. 1280  COLOR 0,7 : LOCATE  7,3 : PRINT " 4"; : COLOR 2,0
  124. 1290  LOCATE  7,  8 : PRINT "UPDATPER";
  125. 1300  LOCATE  7, 19 : PRINT "Updates Information in the Persons File."
  126. 1310  COLOR 0,7 : LOCATE  8,3 : PRINT " 5"; : COLOR 2,0
  127. 1320  LOCATE  8,  8 : PRINT "UPDATMAR";
  128. 1330  LOCATE  8, 19 : PRINT "Updates Information in the Marriages File."
  129. 1340  COLOR 0,7 : LOCATE  9,3 : PRINT " 6"; : COLOR 2,0
  130. 1350  LOCATE  9,  8 : PRINT "UPDATORD";
  131. 1360  LOCATE  9, 19 : PRINT "Updates Information in the Ordinances File."
  132. 1370  COLOR 0,7 : LOCATE 10,3 : PRINT " 7"; : COLOR 4,0
  133. 1380  LOCATE 10,  8 : PRINT "INDEXPC ";
  134. 1390  LOCATE 10, 19 : PRINT "Creates a Parent/Child Index.  (For 13, 16 and 18.)";
  135. 1400  COLOR 0,7 : LOCATE 11,3 : PRINT " 8"; : COLOR 4,0
  136. 1410  LOCATE 11,  8 : PRINT "INDEXMAR";
  137. 1420  LOCATE 11, 19 : PRINT "Creates a Marriages Index.  (For 15, 16, 17 and 18.)";
  138. 1430  COLOR 0,7 : LOCATE 12,3 : PRINT " 9"; : COLOR 6,0
  139. 1440  LOCATE 12,  8 : PRINT "PRINTPER";
  140. 1450  LOCATE 12, 19 : PRINT "Prints Information about Persons.";
  141. 1460  COLOR 0,7 : LOCATE 13,3 : PRINT "10"; : COLOR 6,0
  142. 1470  LOCATE 13,  8 : PRINT "PRINTMAR";
  143. 1480  LOCATE 13, 19 : PRINT "Prints Information about Marriages."
  144. 1490  COLOR 0,7 : LOCATE 14,3 : PRINT "11"; : COLOR 6,0
  145. 1500  LOCATE 14,  8 : PRINT "LISTPER ";
  146. 1510  LOCATE 14, 19 : PRINT "Prints a List of the Persons in the Persons File."
  147. 1520  COLOR 0,7 : LOCATE 15,3 : PRINT "12"; : COLOR 6,0
  148. 1530  LOCATE 15,  8 : PRINT "LISTMAR ";
  149. 1540  LOCATE 15, 19 : PRINT "Prints a List of the Marriages in the Marriages File."
  150. 1550  COLOR 0,7 : LOCATE 16,3 : PRINT "13"; : COLOR 6,0
  151. 1560  LOCATE 16,  8 : PRINT "LISTPCI ";
  152. 1570  LOCATE 16, 19 : PRINT "Prints a List of the Parent/Child Index.";
  153. 1580  COLOR 0,7 : LOCATE 17,3 : PRINT "14"; : COLOR 6,0
  154. 1590  LOCATE 17,  8 : PRINT "ALPHAPER";
  155. 1600  LOCATE 17, 19 : PRINT "Prints an Alphabetical List of Persons."
  156. 1610  COLOR 0,7 : LOCATE 18,3 : PRINT "15"; : COLOR 6,0
  157. 1620  LOCATE 18,  8 : PRINT "ALPHAMAR";
  158. 1630  LOCATE 18, 19 : PRINT "Prints an Alphabetical List of Marriages."
  159. 1640  COLOR 0,7 : LOCATE 19,3 : PRINT "16"; : COLOR 3,0
  160. 1650  LOCATE 19,  8 : PRINT "DISPLAY ";
  161. 1660  LOCATE 19, 19 : PRINT "Displays Genealogical Information on the Screen."
  162. 1670  COLOR 0,7 : LOCATE 20,3 : PRINT "17"; : COLOR 2,0
  163. 1680  LOCATE 20,  8 : PRINT "PEDIGREE";
  164. 1690  LOCATE 20, 19 : PRINT "Prints Pedigree Charts (Family Trees)."
  165. 1700  COLOR 0,7 : LOCATE 21,3 : PRINT "18"; : COLOR 2,0
  166. 1710  LOCATE 21,  8 : PRINT "FAMILY  ";
  167. 1720  LOCATE 21, 19 : PRINT "Prints Family Group Sheets."
  168. 1722  COLOR 0,7 : LOCATE 22,3 : PRINT "19"; : COLOR 3,0
  169. 1724  LOCATE 22,  8 : PRINT "DESCEND";
  170. 1726  LOCATE 22, 19 : PRINT "Displays (and Optionally Prints) Descendents Charts."
  171. 1727  COLOR 7,0
  172. 1730  REM Now obtain User Response
  173. 1735  LOCATE 25,2 : PRINT "(0 to quit, 20 to restart the MENU)";
  174. 1740  LOCATE 24,1 : INPUT "Enter a Program Number and press RETURN."; REPLY$
  175. 1745  IF REPLY$ = "" THEN 1740
  176. 1750  REPLY = VAL(REPLY$)
  177. 1755  IF REPLY = 0 THEN 2900
  178. 1760  IF REPLY < 0 OR REPLY > 20 THEN 780
  179. 1790  IF REPLY =  1 THEN RUN "a:creatper"
  180. 1800  IF REPLY =  2 THEN RUN "a:creatmar"
  181. 1810  IF REPLY =  3 THEN RUN "a:creatord"
  182. 1820  IF REPLY =  4 THEN RUN "a:updatper"
  183. 1830  IF REPLY =  5 THEN RUN "a:updatmar"
  184. 1840  IF REPLY =  6 THEN RUN "a:updatord"
  185. 1850  IF REPLY =  7 THEN RUN "a:indexpc"
  186. 1860  IF REPLY =  8 THEN RUN "a:indexmar"
  187. 1870  IF REPLY =  9 THEN RUN "a:printper"
  188. 1880  IF REPLY = 10 THEN RUN "a:printmar"
  189. 1890  IF REPLY = 11 THEN RUN "a:listper"
  190. 1900  IF REPLY = 12 THEN RUN "a:listmar"
  191. 1910  IF REPLY = 13 THEN RUN "a:listpci"
  192. 1920  IF REPLY = 14 THEN RUN "a:alphaper"
  193. 1930  IF REPLY = 15 THEN RUN "a:alphamar"
  194. 1940  IF REPLY = 16 THEN RUN "a:display"
  195. 1950  IF REPLY = 17 THEN RUN "a:pedigree"
  196. 1960  IF REPLY = 18 THEN RUN "a:family"
  197. 1970  IF REPLY = 19 THEN RUN "a:descend"
  198. 1980  IF REPLY = 20 THEN RUN "a:menu"
  199. 2590  STOP
  200. 2600  REM Shouldn't get to here, but if you do, quit.
  201. 2610  GOTO 2900
  202. 2620  REM Subroutine to draw a double horizontal line.  Attach to double.
  203. 2625  COLOR 5
  204. 2630  FOR J = C1 + 1 TO C2 - 1
  205. 2640   LOCATE R1,J : PRINT CHR$(205);
  206. 2650  NEXT J
  207. 2660  LOCATE R1,C1 : PRINT CHR$(204);
  208. 2670  LOCATE R1,C2 : PRINT CHR$(185);
  209. 2675  COLOR 7
  210. 2680  RETURN
  211. 2690  REM Subroutine to draw a single horizontal line.  Attach to double.
  212. 2695  COLOR 5
  213. 2700  FOR J = C1 + 1 TO C2 - 1
  214. 2710   LOCATE R1,J : PRINT CHR$(196);
  215. 2720  NEXT J
  216. 2730  LOCATE R1,C1 : PRINT CHR$(199);
  217. 2740  LOCATE R1,C2 : PRINT CHR$(182);
  218. 2745  COLOR 7
  219. 2750  RETURN
  220. 2760  REM Subroutine to draw a double vertical line.  Attach to double.
  221. 2765  COLOR 5
  222. 2770  FOR I = R1 + 1 TO R2 - 1
  223. 2780   LOCATE I,C1 : PRINT CHR$(186);
  224. 2790  NEXT I
  225. 2800  LOCATE R1,C1 : PRINT CHR$(203);
  226. 2810  LOCATE R2,C1 : PRINT CHR$(202);
  227. 2815  COLOR 7
  228. 2820  RETURN
  229. 2830  REM Subroutine to draw a single vertical line.  Attach to double.
  230. 2835  COLOR 5
  231. 2840  FOR I = R1 + 1 TO R2 - 1
  232. 2850   LOCATE I,C1 : PRINT CHR$(179);
  233. 2860  NEXT I
  234. 2870  LOCATE R1,C1 : PRINT CHR$(209);
  235. 2880  LOCATE R2,C1 : PRINT CHR$(207);
  236. 2885  COLOR 7
  237. 2890  RETURN
  238. 2900  CLS : LOCATE 21,1
  239. 2910  PRINT "End of Program"
  240. 2920  END
  241.